            BOI.5. (Numere Fibonacci prime). S[ se listeze toate numerele prime
x (10x65535) care:
 i. Sunt numere Fibonacci, i
ii. Permutnd cifrele lui x se obine cel puin nc[ un num[r prim distinct.
           Ieirea va consta dintr-un num[r de linii egal cu num[rul de elemente
existent. Fiecare linie va conine num[rul x urmat - dup[ un spaiu - de num[rul
prim obinut din x printr-o permutare a cifrelor.
Exemplu: Ieirea va ncepe astfel:
13 31
.....
Indicaie: Secvena de numere Fibonacci se construiete dup[ regula:
F0=0,F1=1,Fi=Fi-1+Fi-2, zi2.
================================================
    BOI 5 (Iuliu Vasilescu):
program fibonacci;
var i,j,k,l:longint;
    a,b,c:array[1..7] of integer;
    n:integer;r:boolean;
---------------------------------------------------
function prim(x:longint):boolean;
   {Verifica daca argumentul e numar prim sau nu}
var i,k:longint;t:boolean;
begin
  t:=true;k:=round(sqrt(x));
  for i:=2 to k do if x mod i=0 then begin t:=false;i:=k; end;
  prim:=t;
end;
-------------------------------------------------------
procedure genperm(x:integer);
  {cauta recursiv intre permutarile cifrelor numarului curent
   un numar prim diferit de cel initial; in variabila "r" se
   va afla rezultatul cautarii; cautarea este abandonata la
   gasirea primului numar care satisface conditia}
var k:longint;i:integer;
begin
  if x>n then begin
    k:=0;
    for i:=1 to n do k:=k*10+c[a[i]];
    if (k<>j)and(prim(k)) then r:=true;
  end else
    for i:=1 to n do if (not r) and (b[i]=0) then begin
      b[i]:=1;
      a[x]:=i;
      genperm(x+1);
      b[i]:=0;
    end;
end;
----------------------------------------------------
begin {program principal)
  {se genereaza numerele Fibonacci si pentru fiecare se verifica
celelalte conditii}
  i:=0;j:=1;
  while i<65535 do begin
    k:=i+j;i:=j;j:=k;
    if (j>=10)and(prim(j)) then begin
       r:=false; n:=0; k:=j;
       while k>0 do begin
         inc(n); c[n]:=k mod 10; k:=k div 10  end;
      for k:=1 to n do b[k]:=0;
      genperm(1);
      if r then begin
        write(j,' ');
        for k:=1 to n do write(c[a[k]]);writeln; end;
                               end;
                    end;
end.
----------------------------------------------
Solutia 2: (Vlad Atanasiu)
uses crt;
type numar=array[1..5] of byte;
var fi1,fi2, { folosesc pentru dezvoltarea Fibonacci }
    x,xn:longint;
    a,b:numar; {in vectorul a se memoreaza indexul iar in b
numarul }
    i,dig:byte;
    gasit,sfarsit:boolean;
---------------------------------------------------------
function fibonacci:longint; 
{ intoarce urmatorul termen din sirul Fibonacci }
var x:longint;
begin
   x:=fi1+fi2; { calculeaza termenul }
   fi2:=fi1;  { actualizeaza fi1 si fi2 }
   fi1:=x; fibonacci:=x;
end;
---------------------------------------------------------
procedure permuta(n:integer); 
{ procedura modifica vectorul a astfel incat sa contina
urmatoarea permutare posibila. x este numarul de digiti pentru
care se calculeaza permutarea; de exemplu, la numere de 3 cifre
se vor calcula doar permutarile de 3 (1x2x3=6 permutari) .}
var i,x,j,k,min,minx:integer;
begin
   i:=n;
   if i=1 then
     begin
       sfarsit:=true; i:=0;
     end;
   while i>1 do
     if a[i]>a[i-1] then
       begin
         min:=5; minx:=1;
         for k:=i to n do
            if (a[k]>a[i-1]) and (a[k]-a[i-1]<min) then
               begin
                 min:=a[k]-a[i-1]; minx:=k;
               end;
        x:=a[minx]; a[minx]:=a[i-1]; a[i-1]:=x;
        for k:=n-1 downto i do
           for j:=i to k do
              if a[j]>a[j+1] then
                 begin
                   x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x;
                 end;
       i:=0;
     end
                    else 
     begin
       dec(i);
       if i=1 then sfarsit:=true;
     end;
end;
---------------------------------------------------------
function xtoa(x:longint;var a:numar):integer;
{ functia realizeaza transferul digitilor lui x in vectorul a
}
var nrd:integer;
    b:numar;
begin
   nrd:=1;
   while x<>0 do
      begin
        b[nrd]:=x mod 10;
        x:=x div 10; inc(nrd);
      end;
   xtoa:=nrd-1; 
   for i:=1 to nrd do a[i]:=b[nrd-i];
end;
---------------------------------------------------------
function new_number(var a,b:numar;nrd:byte):longint; 
{ procedura construieste permutarea numarului aflat in vectorul
b in functie de indecsii din a, si il intoarce ca valoare
longint. }
var i:integer;
    x:longint;
begin
   x:=0;
   for i:=1 to nrd do x:=10*x+b[a[i]];
{ exemplu: daca numarul este 54231 iar indexul 14253 numarul
construit va fi 53412 }
   new_number:=x;
end;
---------------------------------------------------------
function prim(x:longint):boolean; { intoarce True daca x este
prim }
var i:longint;
    gasit:boolean;
begin
   if x mod 2=0 then gasit:=true 
{se elimina din start numerele pare}
                else gasit:=false;
   i:=3; { se incepe cu 3 testul de divizibilitate }
   while (i<x div 2) and not gasit do
      begin
        if x mod i=0 then gasit:=true;
        i:=i+2; {si se avanseaza numai in numere impare}
      end;
   prim:=not gasit; 
{numarul este prim daca nu a fost gasit nici un divizor }
end;
---------------------------------------------------------
begin { Programul principal }
   clrscr; fi1:=1; fi2:=1;
   x:=1; 
{se incepe cu al doilea termen de 1 din sirul Fibonacci }
   while x<65535 do begin
        sfarsit:=false; 
{sfarsit va lua valoarea True cand vor fi incheiate toate
permutarile}
        gasit:=false; 
{ gasit va lua valoarea True cand se va gasi o permutare din
care sa rezulte un numar prim }
        dig:=xtoa(x,b);  
{ transfera numarul digit cu digit in vectorul b }
        for i:=1 to 5 do a[i]:=i; 
{ a contine pentru inceput permutarea identica, care NU va fi
analizata (inainte de orice analiza se trece la urmatoarea
permutare) }
        while (not sfarsit) and (not gasit) do
           begin
    repeat permuta(dig) until (a[dig] mod 2=1) or sfarsit;
{ elimina din start permutarile divizibile cu 2 }
             xn:=new_number(a,b,dig); 
{ construieste numarul rezultat in functie de permutarea
obtinuta anterior }
    if prim(xn) and (not sfarsit) then gasit:=true;
{ daca este prim anunta ca a gasit un numar prim si iese din
ciclu }
            end;
      if gasit then writeln(x,' - ',xn); 
{ daca s-a gasit o permutare prima se afiseaza numarul si
permutarea}
      repeat x:=fibonacci until (prim(x) or (x>65535));
      { se calculeaza urmatorul numar prim Fibonacci }
    end;
end.
---------------------------------------
